home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH8 / SRC / SIERPBOX.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-07  |  3.8 KB  |  129 lines
  1. VERSION 4.00
  2. Begin VB.Form SierpBoxForm 
  3.    Caption         =   "Sierpinski Box"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   1185
  7.    ClientWidth     =   5400
  8.    Height          =   5025
  9.    Left            =   2220
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   289
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   360
  14.    Top             =   555
  15.    Width           =   5520
  16.    Begin VB.TextBox LevelText 
  17.       Height          =   285
  18.       Left            =   600
  19.       MaxLength       =   3
  20.       TabIndex        =   0
  21.       Text            =   "4"
  22.       Top             =   0
  23.       Width           =   375
  24.    End
  25.    Begin VB.PictureBox Canvas 
  26.       AutoRedraw      =   -1  'True
  27.       FillStyle       =   0  'Solid
  28.       Height          =   4335
  29.       Left            =   1080
  30.       ScaleHeight     =   285
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   277
  33.       TabIndex        =   3
  34.       Top             =   0
  35.       Width           =   4215
  36.    End
  37.    Begin VB.CommandButton CmdGo 
  38.       Caption         =   "Go"
  39.       Default         =   -1  'True
  40.       Height          =   495
  41.       Left            =   120
  42.       TabIndex        =   1
  43.       Top             =   480
  44.       Width           =   735
  45.    End
  46.    Begin VB.Label Label1 
  47.       Caption         =   "Level"
  48.       Height          =   255
  49.       Index           =   0
  50.       Left            =   0
  51.       TabIndex        =   2
  52.       Top             =   0
  53.       Width           =   495
  54.    End
  55.    Begin VB.Menu mnuFile 
  56.       Caption         =   "&File"
  57.       Begin VB.Menu mnuFileExit 
  58.          Caption         =   "E&xit"
  59.       End
  60.    End
  61. Attribute VB_Name = "SierpBoxForm"
  62. Attribute VB_Creatable = False
  63. Attribute VB_Exposed = False
  64. Option Explicit
  65. Dim TheLevel As Integer
  66. Dim StartX1 As Single
  67. Dim StartY1 As Single
  68. Dim StartX4 As Single
  69. Dim StartY4 As Single
  70. ' ************************************************
  71. ' Draw a Sierpinski box.
  72. ' ************************************************
  73. Sub SierpBox(level As Integer, x1 As Single, y1 As Single, x4 As Single, y4 As Single)
  74. Dim x2 As Single
  75. Dim y2 As Single
  76. Dim x3 As Single
  77. Dim y3 As Single
  78.     ' Fill the square.
  79.     Canvas.Line (x1, y1)-(x4, y4), vbBlack, BF
  80.             
  81.     ' If this is a level 0 gasket, we're done.
  82.     If level < 1 Then Exit Sub
  83.         
  84.     ' Find the corners of the sub-squares.
  85.     x2 = (2 * x1 + x4) / 3
  86.     x3 = (x1 + 2 * x4) / 3
  87.     y2 = (2 * y1 + y4) / 3
  88.     y3 = (y1 + 2 * y4) / 3
  89.     ' Erase the middle square.
  90.     Canvas.Line (x2, y2)-(x3, y3), Canvas.BackColor, BF
  91.     ' Recursively make the other gaskets.
  92.     SierpBox level - 1, x1, y1, x2, y2
  93.     SierpBox level - 1, x2, y1, x3, y2
  94.     SierpBox level - 1, x3, y1, x4, y2
  95.     SierpBox level - 1, x1, y2, x2, y3
  96.     SierpBox level - 1, x3, y2, x4, y3
  97.     SierpBox level - 1, x1, y3, x2, y4
  98.     SierpBox level - 1, x2, y3, x3, y4
  99.     SierpBox level - 1, x3, y3, x4, y4
  100. End Sub
  101. Sub GetParameters()
  102.     If Not IsNumeric(LevelText.Text) Then _
  103.         LevelText.Text = "5"
  104.     TheLevel = CInt(LevelText.Text)
  105. End Sub
  106. Private Sub CmdGo_Click()
  107. Dim i As Integer
  108.     MousePointer = vbHourglass
  109.     DoEvents
  110.     ' Get the parameters.
  111.     GetParameters
  112.     ' Draw the curve.
  113.     Canvas.Cls
  114.     SierpBox TheLevel, StartX1, StartY1, StartX4, StartY4
  115.     MousePointer = vbDefault
  116. End Sub
  117. Private Sub Form_Resize()
  118.     Canvas.Move Canvas.Left, 0, _
  119.         ScaleWidth - Canvas.Left, ScaleHeight - 1
  120.     ' See where the first corners should be.
  121.     StartX1 = Canvas.ScaleWidth * 0.05
  122.     StartX4 = Canvas.ScaleWidth * 0.95
  123.     StartY1 = Canvas.ScaleHeight * 0.05
  124.     StartY4 = Canvas.ScaleHeight * 0.95
  125. End Sub
  126. Private Sub mnuFileExit_Click()
  127.     Unload Me
  128. End Sub
  129.